The PC-SIG Library 10/The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso/PC_SIGCD/15/2/DISK1523.ZIP/OTH.PAS

Pascal/Delphi Source File | 1980-01-01 | 55KB | 1,591 lines

program othello;
{The following program incorporates data structures and game
 strategies to produce a computerized version of othello (reversi) for
 educational and entertainment purposes.  This program was
 originally written on turbo pascal 4.0 but is fully compatable
 with 5.0 and all IBM PC compatable computers.

 Editing Programmer : Erich J Spengler.

 Programmers : Andy Collinson,
               Mark Bensley, Brett Bensley
               Karla Richter, Erich Spengler.

 Procedure Programmers :

 1) Erich J Spengler : cursor, set_window, print_menu, print_board_frame,
                       count, finalcount, print_board, init_game,
                       reverse_board, findmoves, value_print, locate_square,
                       getcoord, ((((chk_A_add, recommend, lookahead----
                       replaced by Karla's lookahead)))), first_move,
                       second_move_1, second_move_2, deter_winner,
                       check_game_done, pick_option, execute_first_move,
                       execute_second_move, terminate_game, Main-Routine.
                       (many of the above came from reference material)

 2) Andy Collinson  : initweigharray, findbestmove.

 3) Mark Bensley    : makemoves, getcoord.

 4) Brett Bensley   : unmove, title_and_instructions, getcoord.

 4) Karla Richter   : LookAhead( Can be beaten in 8 moves every time???? ).

Cooperation Time    : Andy  - 4.0 Hours.
(Time spent with      Mark  - 4.0 Hours.
 Editor)              Brett  - 4.0 Hours.
                      Karla - 1.0 Hours.
}

uses
   crt,       { standard i/o }
   dos;       { for register manipulation }

type
   string2        = string[2];            {string type of length 2}
   makmovetype    = record                {record type containing..}
                       imm,               {..a single move}
                       jmm  : shortint;
                    end;
   squaretype     = record                {record type containing..}
                       data : shortint;   {..data in each board square}
                    end;
   possmvsrectype = record                {record type containing..}
                      row,                {..possible moves and..}
                      col,                {..corresponding flips}
                      nflps : shortint;
                    end;
   bestmvetype    = record                {record type containing..}
                       xcoord,            {..best move and board value}
                       ycoord,
                       val  : longint;
                    end;
   on_off_type    = (on,off);             {on,off switch type}
   movetype       = (good,bad);           {good or bad move type}
   playtype       = (first,second);       {which player is moving}
   coordstatustype= (ok,non_avail);       {status for empty board square}
   actiontype     = (save,return);        {choice for saving a board}
   gamestatus     = (first_win,second_win,tie,continue); {type for who wins}
   a1type         = array[1..8] of shortint;
   a2type         = array[1..10,1..10] of shortint;
   a3type         = array[1..10,1..10] of squaretype;
   a4type         = array[1..30] of possmvsrectype;
   a5type         = array[2..9,2..9] of shortint;
   xorbtype       = a1type;               {type for x board orbiting}
   yorbtype       = a1type;               {type for y board orbiting}
   flparrytype    = a2type;               {array for temp storage of flips}
   boardarrytype  = a3type;               {board storage array}
   posmvarrytype  = a4type;               {possible move storage}
   weigharraytype = a5type;               {weight of possible moves storage}

const
   empty = '  ';                          {empty color}
   firstchr = '░░';                       {first piece color}
   secondchr = '██';                      {second piece color}
   firstnum = 1;                          {first number}
   secondnum = -1;                        {second number}

var
   ch          : char;                    {keyboard character}
   xorb        : a1type;                  {x orbiting array}
   yorb        : a1type;                  {y orbiting array}
   play_1,                                {boolean for one or two players}
   quit,                                  {for quitting game}
   pass,                                  {for passing turn}
   done        : boolean;                 {when game is done}
   level       : integer;                 {level of computer tree search}
   play        : playtype;                {which player is playing}
   game        : gamestatus;              {what status game is in}
   board,                                 {playing board}
   board2,                                {tree searching board}
   tempboard,                             {tempoary boards 1-3}
   tempboard2,
   tempboard3  : boardarrytype;
   weigharr    : weigharraytype;          {weight array for move value}

{************************ PASCAL CODE FOR OTHELLO ***************************}

procedure cursor(stype:char;switch:on_off_type);
{shuts off or on cursor using interrupt and register change}
var
   regs : registers;
begin
   with regs do
      begin
         ah := $01;
         if switch = on then                {turn on}
            begin
               case stype of
               'M' : begin                  {for mono board}
                        ch := 12;
                        cl := 13;
                     end;                   {for color board}
               'C' : begin
                        ch := 6;
                        cl := 7;
                     end;
               else ;
            end;
         end
      else
         begin
            case stype of                   {turn off}
            'M' : begin                     {for mono board}
                     ch := 14;
                     cl := 14;
                  end;
            'C' : begin                     {for color board}
                     ch := 8;
                     cl := 8;
                  end;
            else ;
         end;
      end;
   end;
   intr($10,regs);                          {call interrupt}
end;

procedure title_and_instructions;
{print title page and game instructions}
var
   inccount    : 2..24;
   key         : string;
begin
   clrscr;
   write('╔══════════════════════════════════════════════════════════════════════════════╗');
   for inccount := 2 to 23 do
   write('║                                                                              ║');
   write('╚══════════════════════════════════════════════════════════════════════════════╝');
   gotoxy(34,2);
   write('   ║╩╩╩║       ');
   gotoxy(34,3);
   write('╔══╩╗ ╔╩╦═╗    ');
   gotoxy(34,4);
   write('║  ═╣ ║ ║ ║    ');
   gotoxy(34,5);
   write('║  ═╣ ║ ╨ ║    ');
   gotoxy(34,6);
   write('╚═══╩═╩═══╝');
   highvideo;
   gotoxy(19,8);
   write('█████ █████ █  █ █████ █     █     █████  (R)');
   gotoxy(19,9);
   write('█▒▒▒█▒ ▒█▒▒▒█▒ █▒█▒▒▒▒▒█▒    █▒    █▒▒▒█▒');
   gotoxy(19,10);
   write('█▒  █▒  █▒  ████▒████  █▒    █▒    █▒  █▒');
   gotoxy(19,11);
   write('█▒  █▒  █▒  █▒▒█▒█▒▒▒▒ █▒    █▒    █▒  █▒');
   gotoxy(19,12);
   write('█████▒  █▒  █▒ █▒█████ █████ █████ █████▒');
   gotoxy(19,13);
   write(' ▒▒▒▒▒   ▒   ▒  ▒ ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒▒');
   gotoxy(15,15);
   lowvideo;
   write('Produced by students of MAT 4870 "Data Structures"');
   gotoxy(18,16);
   write('Eastern Illinois University, Charleston, IL');
   gotoxy(31,17);
   write('Fall Semester 1988');
   gotoxy(14,20);
   write('(R) Registered Trademark of Gabriel Industries, Inc.');
   gotoxy(22,22);
   write('(C) Game Copyright MCMLXXVII Gabriel');
   gotoxy(26,24);
   highvideo;
   textattr := textattr+128;
   write(' Press any key to continue. ');
   normvideo;
   gotoxy(19,12);
   repeat until keypressed;
   key := readkey;
   clrscr;
   writeln('Rules :');
   writeln;
   writeln('1. Black moves first.');
   writeln;
   writeln('2. A move consists of "outflanking" (border a row of your opponent',chr(39),'s disc(s)');
   writeln('   with your discs) your opponent',chr(39),'s disc(s) to flip the outflanked disc(s) to');
   writeln('   your color.');
   writeln;
   writeln('3. If a player cannot outflank and flip at least one opponent',chr(39),'s disc, the');
   writeln('   turn is forfeited and the opponent moves again.');
   writeln;
   writeln('4. A disc may outflank any number of discs in one or more rows.');
   writeln;
   writeln('5. A disc may outflank in any direction: horizontal, vertical, diagonal.');
   writeln;
   writeln('6. A disc may outflank in any number of directions at the same time.');
   writeln;
   writeln('7. A disc may only be outflanked as a direct result of a move and must fall');
   writeln('   in the direct line of the disc placed down.');
   writeln;
   writeln('8. The game is over when either no more moves can be made by either player,');
   writeln('   or you quit the game.');
   writeln;
   writeln('9. The player with the most discs of his or her color wins.');
   gotoxy(26,1);
   highvideo;
   textattr := textattr+128;
   write(' Press any key to continue. ');
   normvideo;
   repeat until keypressed;
   key := readkey;
   lowvideo;
   clrscr;
end;

procedure set_window(x1,y1,x2,y2:shortint);
{draw a two bar frame window around given coordinates}
const
   ulc = #201;          {upper left corner}
   hb  = #205;          {horiz bar}
   urc = #187;          {upper right corner}
   vb  = #186;          {vert bar}
   llc = #200;          {lower left corner}
   lrc = #188;          {lower right corner}
var
   i : shortint;        {loop variable}
begin
   gotoxy(x1+1,y1);
   write(ulc);
   for i := x1+1 to x2-2 do            {draw top}
      write(hb);
   write(urc);
   for i := y1+1 to y2-3 do
      begin
         gotoxy(x1+1,i);write(vb);     {draw vert sides}
         gotoxy(x2,i);write(vb);
      end;
   gotoxy(x1+1,y2-2);
   write(llc);
   for i := x1+1 to x2-2 do            {draw bottom}
      write(hb);
   write(lrc);
end;

procedure print_menu;
{draw menu to choose in-play game options}
begin
   set_window(3,2,37,7);
   gotoxy(4,6);
   write('          Message Block           ');
   gotoxy(4,8);
   write('< Move Selector Using Arrow Keys. >');
   gotoxy(4,9);
   write('< Choose Option Before Moving. >');
   gotoxy(6,11);
   write('Game Options');
   gotoxy(11,12);
   write('During Play :');
   gotoxy(8,14);
   write('(Q)uit   : End Game.');             {quit}
   gotoxy(8,16);
   write('(P)ass   : Pass Turn.');            {pass}
   gotoxy(8,18);
   write('(U)ndo   : Undo Last Move.');       {undo move}
   gotoxy(8,20);
   write('(S)witch : Change Players.');       {reverse board}
   gotoxy(8,22);
   write('(H)int   : Hint From Computer.');   {give player hint}
end;

procedure print_board_frame;
{print playing board on the screen - this is only done once}
var
   x, y : shortint;
begin
   print_menu;
   set_window(1,1,80,25);              {draw screen frame}
   gotoxy(49,3);
   write(firstchr,'  ','Player #1 Score : ');
   gotoxy(49,5);
   write(secondchr,'  ','Player #2 Score : ');
   x := 40;
   y := 7;
   gotoxy(x,y);
   write('╔════╤════╤════╤════╤════╤════╤════╤════╣');
   gotoxy(x,y+1);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+2);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+3);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+4);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+5);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+6);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+7);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+8);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+9);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+10);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+11);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+12);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+13);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+14);
   write('╟────┼────┼────┼────┼────┼────┼────┼────╢');
   gotoxy(x,y+15);
   write('║    │    │    │    │    │    │    │    ║');
   gotoxy(x,y+16);
   write('╩════╧════╧════╧════╧════╧════╧════╧════╝');
end;

procedure unmove(var board,tempboard:boardarrytype;action:actiontype);
{save or return a board into or from another board}
var
   x,y : shortint;
begin
   if action = save then
      begin
         for x := 1 to 10 do
            for y := 1 to 10 do
               tempboard[x,y].data := board[x,y].data;
      end
   else
      begin
         for x := 1 to 10 do
            for y := 1 to 10 do
               board[x,y].data := tempboard[x,y].data;
      end;
end;

procedure count(board:boardarrytype;var game:gamestatus);
{count pieces of each player and set game to whos winning}
var
   i, j,                   {loop variables}
   ply_pieces,             {first players pieces}
   cmp_pieces : shortint;  {second players pieces}
begin
   ply_pieces := 0;
   cmp_pieces := 0;
   for i := 2 to 9 do
      for j := 2 to 9 do
         with board[i,j] do
         begin
            if data = 1 then
               inc(ply_pieces)
            else if data = -1 then
               inc(cmp_pieces);
         end;
   if ply_pieces + cmp_pieces = 64 then      {check total pieces}
      if ply_pieces > cmp_pieces then        {compare....}
         game := first_win
      else if ply_pieces < cmp_pieces then
         game := second_win
      else if ply_pieces=cmp_pieces then
         game := tie;
   if ply_pieces + cmp_pieces <> 64 then
      if (ply_pieces=0)  then
         game := second_win
      else if (cmp_pieces=0) then
         game := first_win
      else
         game := continue;
end;

procedure finalcount(board:boardarrytype;
                     var ply_pieces,cmp_pieces:shortint);
{count each number of players in a given board}
var
   i,j : shortint; {loop variables}
begin
   ply_pieces := 0;
   cmp_pieces := 0;
   for i := 2 to 9 do                        {loop until board counted}
      for j := 2 to 9 do
         with board[i,j] do
            begin
               if data = 1 then
                  inc(ply_pieces)
               else if data = -1 then
                  inc(cmp_pieces);
            end;
end;

procedure print_board(board:boardarrytype;var game:gamestatus);
{print board and current scores for each player}
var
   i, j,
   x, y,
   plyscr, cmpscr : shortint;   {board values and loop variables}
   chstr          : string2;
begin
   x := 42;
   y := 8;
   plyscr := 0;
   cmpscr := 0;
   for i := 2 to 9 do
      begin
         for j := 2 to 9 do
            begin
               with board[i,j] do
                  begin
                     if data =  0 then
                        chstr := empty
                     else if data = -1 then
                        begin
                           chstr := secondchr;
                           inc(cmpscr);
                        end
                     else if data =  1 then
                        begin
                           chstr := firstchr;
                           inc(plyscr);
                        end;
                     gotoxy(x,y);
                     write(chstr);
                     x := x + 5;
                  end;
            end;
         x := 42;
         y := y+2;
      end;
   gotoxy(70,3);           {write scores}
   write(plyscr:2);
   gotoxy(70,5);
   write(cmpscr:2);
end;

procedure initweigharray(var weigharr:weigharraytype);
{initialize weight array for board values during computer play}
{each square is given a special strategy weight}
begin
   weigharr[2,2] := 26 ;weigharr[2,3] := 1  ;weigharr[2,4] := 17;
   weigharr[2,5] := 15 ;weigharr[2,6] := 15 ;weigharr[2,7] := 17;
   weigharr[2,8] := 1  ;weigharr[2,9] := 26 ;weigharr[3,2] := 1;
   weigharr[3,3] := 1  ;weigharr[3,4] := 5  ;weigharr[3,5] := 6;
   weigharr[3,6] := 6  ;weigharr[3,7] := 5  ;weigharr[3,8] := 1;
   weigharr[3,9] := 1  ;weigharr[4,2] := 17 ;weigharr[4,3] := 5;
   weigharr[4,4] := 8  ;weigharr[4,5] := 9  ;weigharr[4,6] := 9;
   weigharr[4,7] := 8  ;weigharr[4,8] := 5  ;weigharr[4,9] := 17;
   weigharr[5,2] := 15 ;weigharr[5,3] := 6  ;weigharr[5,4] := 9;
   weigharr[5,7] := 9  ;weigharr[5,8] := 6  ;weigharr[5,9] := 15;
   weigharr[6,2] := 15 ;weigharr[6,3] := 6  ;weigharr[6,4] := 9;
   weigharr[6,7] := 9  ;weigharr[6,8] := 6  ;weigharr[6,9] := 15;
   weigharr[7,2] := 17 ;weigharr[7,3] := 5  ;weigharr[7,4] := 8;
   weigharr[7,5] := 9  ;weigharr[7,6] := 9  ;weigharr[7,7] := 8;
   weigharr[7,8] := 5  ;weigharr[7,9] := 17 ;weigharr[8,2] := 1;
   weigharr[8,3] := 1  ;weigharr[8,4] := 5  ;weigharr[8,5] := 6;
   weigharr[8,6] := 6  ;weigharr[8,7] := 5  ;weigharr[8,8] := 1;
   weigharr[8,9] := 1  ;weigharr[9,2] := 26 ;weigharr[9,3] := 1;
   weigharr[9,4] := 17 ;weigharr[9,5] := 15 ;weigharr[9,6] := 15;
   weigharr[9,7] := 17 ;weigharr[9,8] := 1  ;weigharr[9,9] := 26;
end;

procedure init_game(var board:boardarrytype);
{initialize game and all necessary variables}
var
   e        : integer;       {error code for val call}
   i, j,                     {loop variables}
   plyscr,                   {players score}
   num_play,                 {number of players}
   cmpscr   : shortint;      {second players score}
begin
   clrscr;                   {clear screen}
   randomize;                {have extra ramdom numbers if needed}
   quit:=false;              {set quit to false}
   pass:=false;              {set pass to false}
   done := false;            {set done to no}
   game := continue;         {let game continue}
   cursor('M',off);          {shut off cursor}
   cursor('M',off);          {just making sure}
   title_and_instructions;   {print title page and instructions}
   initweigharray(weigharr); {initialize weight array}
                             {initialize orbit arrays}
   xorb[1] := -1;xorb[2] := -1;xorb[3] := 0;xorb[4]  := 1;
   yorb[1] := 0;yorb[2]  := 1;yorb[3]  := 1;yorb[4]  := 1;
   xorb[5] := 1;xorb[6]  := 1;xorb[7]  := 0;xorb[8]  := -1;
   yorb[5] := 0;yorb[6]  := -1;yorb[7] := -1;yorb[8] := -1;
   {set board pieces to blank}
   for i := 1 to 10 do
      begin
         for j := 1 to 10 do
            begin
               with board[i,j] do
                  begin
                     data := 0;
                  end;
            end;
      end;
   plyscr := 2;                    {initialize player 1 score}
   cmpscr := 2;                    {initialize player 2 score}
   board[5,5].data := 1;           {first initialization}
   board[6,6].data := 1;
   board[5,6].data := -1;          {second initialization}
   board[6,5].data := -1;
   unmove(board,tempboard,save);   {set temporary boards to original}
   unmove(board,tempboard2,save);
   unmove(board,tempboard3,save);
   for i := 1 to 10 do
      begin                        {set boarder of board...}
         with board[1,i] do        {...values to 2}
            data := 2;
         with board[10,i] do
            data := 2;
         with board[i,1] do
            data := 2;
         with board[i,10] do
            data := 2;
      end;
   print_board_frame;              {print board frame}
   print_board(board,game);        {print board}
   gotoxy(6,3);
   write('Enter # of Players (1,2) : ');  {ask number of players}
   repeat                                 {read in # of players}
      gotoxy(33,3);
      write(' ');
      gotoxy(33,3);
      read(ch);
   until ch in ['1'..'2'];
   val(ch,num_play,e);                    {change character to numeric}
   gotoxy(6,3);
   write(' ':30);
   case num_play of                       {set boolean for player #}
      1 : play_1 := true;
      2 : play_1 := false;
   end;
   if play_1 then                         {if computer plays set level}
      begin
         gotoxy(6,3);
         write('Enter Play Level (1-4) : ');
         repeat
            gotoxy(31,3);                 {read in player level}
            write(' ');
            gotoxy(31,3);
            read(ch);
         until ch in ['1'..'4'];
         val(ch,level,e);                 {change char to numeric}
         gotoxy(6,3);
         write(' ':30);
         case level of                    {set level of tree search}
            1 : level := 0; {*****no pruning procedure,...}
            2 : level := 1; {...therefore a search greater than 3...}
            3 : level := 2; {...takes an extremely long time...}
            4 : level := 3; {...but lookahead does not work...}
         end                {...correctly at search level 3********}
      end
   else                              {should never leave un set variables}
      level:=1;                      {else set level to 1}
end;

procedure reverse_board(var board:boardarrytype);
{procedure will reverse a given board}
var
   i, j  : shortint;
   value : shortint;
begin
   for i := 2 to 9 do                    {loop through board}
      begin
         for j := 2 to 9 do
            begin
               with board[i,j] do
                  begin
                     if data=-1 then
                        value := 1        {switch numbers of board}
                     else if data=1 then
                        value := -1
                     else
                        value := 0;
                     data  :=  value;
                  end;
            end;
      end;
   print_board(board,game);   {print reversed board}
   gotoxy(6,4);               {goto message block for message set up}
end;

procedure findmoves(board:boardarrytype;player:shortint;
                    var possmvs : posmvarrytype);
{find all possible moves for a given player and then load an array
 with those moves and corresponding possible flips}
{this will be done by using the orbit arrays to circle around and
 search all possible directions until a move is found to be good or bad}
var
   i, j, k,                    {loop variables}
   x, y, z,                    {more loop variables}
   nflips,                     {flips possible for each move}
   mvi, mvj,                   {move values for directional search}
   imov, jmov,                 {temp values for mvi and mvj}
   value       : shortint;     {value of board piece}
   done        : boolean;      {indicates end of directional search}
   move        : movetype;     {type set if move is good}
   flipcnt     : flparrytype;  {array of flips for each direction}
begin
   count(board,game);
   if game <> continue then
      done := true
   else
      begin
         for i := 1 to 30 do   {set possible array to 0}
            with possmvs[i] do
               begin
                  row   := 0;
                  col   := 0;
                  nflps := 0;
               end;
            for i := 1 to 10 do         {set flip array to 0}
               for j := 1 to 10 do
                  flipcnt[i,j]:=0;
               for i  :=  2 to 9 do     {use 2 loops to cover all moves}
                  begin
                     for j := 2 to 9 do
                        begin
                           with board[i,j] do  {extract value from board}
                              value := data;
                           if value = player then  {check value of player}
                              begin
                                 for k := 1 to 8 do {search 8 poss directions}
                                    begin
                                       move := bad; {initialize move to bad}
                                       mvi := i + xorb[k];{go first direction}
                                       mvj := j + yorb[k];{go second direct}
                                       with board[mvi,mvj] do
     {get value from direction search}    value := data;
     {make sure it is a good direct}   if value = -(player) then
                                          begin
     {set flip counter to one}               nflips := 1;
     {repeat search until move is over }     repeat
     {continue to scan}                         mvi := mvi + xorb[k];
                                                mvj := mvj + yorb[k];
     {get next square value}                    with board[mvi,mvj] do
     {if value is 0 then a move can be made}       value := data;
                                                if value = 0 then
                                                   begin
     {set move to good}                               done := true;
     {indicate done with search for direction}        move := good;
     {reset to original square for next search}       imov := mvi;
                                                      jmov := mvj;
                                                   end
     {if value is still opposite of ...}        else if value = -(player) then
     {...player, continue to search}               begin
                                                      done := false;
                                                      move  := bad;
                                                      inc(nflips);
                                                   end
     {if value is not good then move is bad}    else if (value=player)
                                                         or (value=2) then
                                                   begin
                                                      done := true;
                                                      move := bad;
                                                   end;
                                             until done;
                                          end;
     {if move is good load into array} if move = good then
                                          flipcnt[imov,jmov]:=
                                          flipcnt[imov,jmov] + nflips;
                                    end;
                              end;
                        end;
                  end;
               z := 0;
               for x := 1 to 10 do          {load possible move array}
                  for y := 1 to 10 do
                     if flipcnt[x,y] <> 0 then
                        begin
                           z := z+1;
                           with possmvs[z] do
                              begin
                                 row := x;
                                 col := y;
                                nflps := flipcnt[x,y];
                              end;
                        end;
      end;
end;

procedure findbestmove(var value:bestmvetype;
                       possmvs:posmvarrytype;
                       board:boardarrytype;whosturn:integer);
{using weight array, find the best possible move}
var
   finalval,
   tempvalue,
   row1,
   col1,
   nflps1, i   : integer;
begin
   if whosturn = board[2,2].data then
      begin
         weigharr[2,3] := 10;
         weigharr[3,2] := 10;
         weigharr[3,3] := 10;
      end;
   if whosturn = board[2,9].data then
      begin
         weigharr[2,8] := 10;
         weigharr[3,8] := 10;
         weigharr[3,9] := 10;
      end;
   if whosturn = board[9,2].data then
      begin
         weigharr[8,2] := 10;
         weigharr[8,3] := 10;
         weigharr[9,3] := 10;
      end;
   if whosturn = board[9,9].data then
      begin
         weigharr[8,8] := 10;
         weigharr[8,9] := 10;
         weigharr[9,8] := 10;
      end;
   value.xcoord := 0;
   value.ycoord := 0;
   value.val  := 0;
   i := 1;
   while possmvs[i].nflps <> 0 do
      begin
         row1 := possmvs[i].row;
         col1 := possmvs[i].col;
         nflps1 := possmvs[i].nflps;
         tempvalue := weigharr[row1,col1] + nflps1;
         if tempvalue > value.val then
            begin
               value.val := tempvalue;
               value.xcoord := possmvs[i].row;
               value.ycoord := possmvs[i].col;
            end;
         i := i + 1;
      end;
end;

PROCEDURE MAKEMOVES(MAKMOVE:MAKMOVETYPE;
                    VAR BOARD:BOARDARRYTYPE;ITEM:SHORTINT);
{make a given move and flip all corresponding pieces}
TYPE
   DIAGONALNEGTYPE=2..20;
   DIAGONALPOSTYPE=-9..9;
VAR
   I2,I1,{USE FOR INCREMENTS}
   POSHORZ,POSVERT,
   TEMPORARYHORZ,
   TEMPORARYVERT,
   TEMPORARYITEM:SHORTINT;
   DIAGONALNEG:DIAGONALNEGTYPE;
   DIAGONALPOS:DIAGONALPOSTYPE;
   ITEMINDICATOR:BOOLEAN;
BEGIN
   POSHORZ := MAKMOVE.IMM;
   POSVERT := MAKMOVE.JMM;
   IF (POSHORZ>1) AND (POSHORZ<10) {MAKES SURE THE POSITION IS}
      AND (POSVERT>1) AND (POSVERT<10) THEN {ON THE BOARD.   }
      BEGIN
         IF ITEM=-1 THEN      {TEMPORARILY STORES VALUE OF}
            TEMPORARYITEM := 1  {OPPOSITE COLOR FOR LATER   }
         ELSE                 {REFERENCE                  }
            TEMPORARYITEM := -1;
         {END IF THEN}
         I2 := -1;
         WHILE I2<2 DO {CHECKS HORIZONTAL TO SEE IF ANY PIECES}
            BEGIN   {CAN BE FLIPPED.                       }
               ITEMINDICATOR := FALSE;
               TEMPORARYHORZ := POSHORZ+I2;
               WHILE BOARD[TEMPORARYHORZ,POSVERT].DATA
                     =TEMPORARYITEM DO
                  BEGIN
                     TEMPORARYHORZ := TEMPORARYHORZ+I2;
                     ITEMINDICATOR := TRUE;
                  END;{WHILE}
                  IF (ITEMINDICATOR AND
                     (BOARD[TEMPORARYHORZ,POSVERT].DATA
                      =ITEM)) THEN
                     BEGIN  {MAKE FLIP}
                        I1 := POSHORZ;
                        WHILE I1<>TEMPORARYHORZ DO
                           BEGIN
                              BOARD[I1,POSVERT].DATA := ITEM;
                              I1 := I1+I2;
                           END;{WHILE}
                     END;{IF THEN}
                     I2 := I2+2;
         END;{WHILE}
         I2 := -1;
         WHILE I2<2 DO {CHECKS VERTICAL TO SEE IF ANY}
            BEGIN   {PIECES CAN BE FLIPPED.       }
               TEMPORARYVERT := POSVERT+I2;
               ITEMINDICATOR := FALSE;
               WHILE BOARD[POSHORZ,TEMPORARYVERT].DATA
                     =TEMPORARYITEM DO
                  BEGIN
                     TEMPORARYVERT := TEMPORARYVERT+I2;
                     ITEMINDICATOR := TRUE;
                  END;{WHILE}
               IF (ITEMINDICATOR AND
                  (BOARD[POSHORZ,TEMPORARYVERT].DATA=ITEM)) THEN
                  BEGIN {MAKE FLIP}
                     I1 := POSVERT;
                     WHILE I1<>TEMPORARYVERT DO
                        BEGIN
                           BOARD[POSHORZ,I1].DATA := ITEM;
                           I1 := I1+I2;
                        END;{WHILE}
                     END;{IF THEN}
                     I2 := I2+2;
                  END;{WHILE}
               DIAGONALPOS := POSHORZ-POSVERT;
               I2 := -2;
               WHILE I2<3 DO {CHECKS NEGHTIVE DIAGONAL TO SEE IF ANY}
                  BEGIN   {PIECES CAN BE FLIPPED.                }
                     DIAGONALNEG := POSHORZ+POSVERT+I2;
                     ITEMINDICATOR := FALSE;
                     WHILE BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2)
                           ,((DIAGONALNEG-DIAGONALPOS) DIV 2)].
                           DATA=TEMPORARYITEM DO
                        BEGIN
                           DIAGONALNEG := DIAGONALNEG+I2;
                           ITEMINDICATOR := TRUE;
                        END;{WHILE}
                     IF (ITEMINDICATOR AND
                        (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2),
                        ((DIAGONALNEG-DIAGONALPOS) DIV 2)].DATA=ITEM)) THEN
                        BEGIN {MAKE FLIP}
                           I1 := POSHORZ+POSVERT;
                           WHILE I1<>DIAGONALNEG DO
                              BEGIN
                                 BOARD[((I1+DIAGONALPOS)
                                      DIV 2),((I1-
                                      DIAGONALPOS) DIV 2)].
                                      DATA := ITEM;
                                 I1 := I1+I2;
                              END;{WHILE}
                        END;{IF THEN}
                     I2 := I2+4;
                  END;{WHILE}
                  DIAGONALNEG := POSHORZ+POSVERT;
                  I2 := -2;
                  WHILE I2<3 DO {CHECKS POSITIVE DIAGONAL TO SEE}
                     BEGIN   {IF ANY PIECES CAN BE FLIPPED.  }
                        DIAGONALPOS := POSHORZ-POSVERT+I2;
                        ITEMINDICATOR := FALSE;
                        WHILE BOARD[((DIAGONALNEG+DIAGONALPOS)
                              DIV 2),((DIAGONALNEG-DIAGONALPOS)
                              DIV 2)].DATA=TEMPORARYITEM DO
                           BEGIN
                              DIAGONALPOS := DIAGONALPOS+I2;
                              ITEMINDICATOR := TRUE;
                           END;{WHILE}
                        IF (ITEMINDICATOR AND
                           (BOARD[((DIAGONALNEG+DIAGONALPOS) DIV 2),
                           ((DIAGONALNEG-DIAGONALPOS) DIV 2)]
                           .DATA=ITEM)) THEN
                           BEGIN {MAKE FLIP}
                              I1 := POSHORZ-POSVERT;
                              WHILE I1<> DIAGONALPOS DO
                                 BEGIN
                                    BOARD[((DIAGONALNEG+I1)
                                         DIV 2),((DIAGONALNEG
                                         -I1) DIV 2)].DATA
                                          := ITEM;
                                    I1 := I1+I2;
                                 END;{WHILE}
                           END;{IF THEN}
                        I2 := I2+4;
                     END;{WHILE}
   END;{IF THEN}
END;{PROCEDURE}

procedure value_print(value:bestmvetype;possmvs:posmvarrytype);
{special proc for debugging, will print all poss moves and best move}
var
   i,j:integer;           {loop variables}
begin                     {blank out section of screen}
   for i := 10 to 25 do
      begin
         gotoxy(5,i);
         write(' ':33);
      end;
   j:=1;                  {set increment variables}
   i:=10;
   gotoxy(5,9);
   write('mvs & flips');
   while possmvs[j].nflps<>0 do
      begin
         gotoxy(5,i);
         with possmvs[j] do
            write(row,'  ',col,'  ',nflps); {write move and # of flips}
         inc(i);        {increment loop variables}
         inc(j);
      end;
   gotoxy(20,9);
   write('best move & value');
   gotoxy(20,10);
   with value do
      write(xcoord,'  ',ycoord,'       ',val); {print best move }
end;

procedure locate_square(var x,y:shortint;var coordstatus:coordstatustype;
                        var findempty:boolean;board:boardarrytype;
                        player:shortint);
{locate an open square on the board and write a char in it}
var
   i, j,
   temparrw,
   xarrw, yarrw,
   tempx, tempy,
   value1, tempplay : shortint; {loop and tempory values}
   playchr,
   tempplaychr      : string2;  {character being played}
   possmvs          : posmvarrytype;  {possible move array}
   value            : bestmvetype;    {value for best possibla move}
begin
   xarrw := 42;                     {indicate who's turn in message block}
   tempplay := player;
   if player = 1 then
      begin
         tempplaychr := '░░';
         yarrw := 3;
         temparrw := 5;
         gotoxy(6,4);
         write(tempplaychr,' ''s turn.');
      end
   else
      begin
         yarrw := 5;
         tempplaychr := '██';
         temparrw := 3;
         gotoxy(6,4);
         write(tempplaychr,' ''s turn.');
      end;
   gotoxy(xarrw,yarrw);     {place arrow at players score}
   write('»════>');
   gotoxy(xarrw,temparrw);
   write('      ');
   playchr := '[]';         {def pick char}
   x := 42;
   y := 8;
   gotoxy(6,3);
   write(' ':30);
   i := 2;
   j := 2;
   coordstatus := ok;
   findempty := false;
   while i < 10 do       {loop until open square found or not found}
      begin
         repeat
            with board[i,j] do
               value1  :=  data;
            if value1 = 0 then     {open square found}
               begin
                  coordstatus := ok;
                  findempty := true;
                  i := 10;
                  tempx := x;
                  tempy := y;
                  gotoxy(x,y);
                  write(playchr:2);
               end
            else
               begin               {open square not found}
                  coordstatus := non_avail;
                  x := x+5;
                  j := j+1;
               end;
         until (findempty) or (j=10);
         x := 42;
         y := y+2;
         i := i+1;
         j := 2;
      end;
   x := tempx;  {set coordinates of found square}
   y := tempy;
{*************** for debuggung *********************************}
{findmoves(board,player,possmvs);
findbestmove(value,possmvs,board,player);
value_print(value,possmvs);}
{***************************************************************}
end;

procedure getcoord(player:shortint;possmvs:posmvarrytype;
                   var makmove:makmovetype);
{select a position on the board for a possible move, if move is good
 then exit procedure else write message and repeat procedure}
var
   x, y, i, j,
   num1, num2,
   yinc, xinc,
   xarrw, yarrw,
   tempx, tempy,
   value1, value2,
   ply_piece, cmp_piece : shortint;
   coordstatus          : coordstatustype;
   ch                   : char;
   findempty,
   fk                   : boolean;
   move                 : movetype;
   tempplay             : shortint;
   playchr,
   tempplaychr          : string2;
begin
   xarrw := 42;
   tempplay := player;
   if player = 1 then
      begin
         tempplaychr := '░░';
         yarrw := 3;
      end
   else
      begin
         yarrw := 5;
         tempplaychr := '██';
      end;
   playchr := '[]';
   locate_square(x,y,coordstatus,findempty,board,player);
   repeat
      if coordstatus = ok then
         begin
            repeat
               i := x;j := y;
               fk := false;
               ch := readkey;
               if ch = #0 then
                  begin
                     fk := true;
                     ch := readkey;
                  end;
               yinc := 0;xinc := 0;
               case ch of
               'H': begin                {left arrow key}
                       y := y-2;
                       yinc := -2;
                    end;
               'P': begin                {right arrow key}
                       y := y+2;
                       yinc := +2;
                    end;
               'K': begin                {up arrow key}
                       x := x-5;
                       xinc := -5;
                    end;                 {down arrow key}
               'M': begin
                       x := x+5;
                       xinc := +5;
                    end;
               end;
               if (x>77) and (y>22) then
                  begin
                     x := 42;
                     y := 8;
                  end
               else if x > 77 then
                  begin
                     x  :=  42;
                     y := y+2;
                  end
               else if x < 42 then
                  begin
                     x :=  77;
                     y :=  y - 2;
                  end;
               if y > 22 then
                  y := 8
               else if y < 8 then
                  y := 22;
               with board[(y-4) div 2,(x-32) div 5] do
                  value1 := data;
               if value1 = 0 then
                  begin
                     gotoxy(i,j);
                     write(empty:2);
                     gotoxy(x,y);
                     write(playchr:2);
                     num1 := (y-4) div 2;
                     num2 := (x-32) div 5;
                  end
               else if (value1 = 1) or (value1 = -1) then
                  begin
                     repeat
                        gotoxy(i,j);
                        write(empty:2);
                        x := x+xinc;
                        y := y+yinc;
                        if (x>77) and (y>22) then
                           begin
                              x := 42;
                              y := 8;
                           end
                        else if x > 77 then
                           begin
                              x  :=  42;
                              y := y + 2;
                           end
                        else if x < 42 then
                           begin
                              x :=  77;
                              y := y - 2;
                           end;
                        if y > 22 then
                           y := 8
                        else if y < 8 then
                           y := 22;
                        with board[(y-4) div 2,(x-32) div 5] do
                           value2 := data;
                     until value2 = 0;
                     gotoxy(x,y);
                     write(playchr:2);
                     num1 := (y-4) div 2;
                     num2 := (x-32) div 5;
                  end;
            until (not fk) and (ch = #13);
         end;
      i := 1;
      move := bad;
      repeat
         with possmvs[i] do
            if (num1=row) and (num2=col) then
               move := good
            else
               begin
                  move := bad;
                  inc(i);
               end;
      until (i=30) or (move=good);
      if move <> good then
         begin
            gotoxy(6,3);
            write('Move is bad : ',tempplaychr);
            repeat
               ch  :=  readkey;
            until (ch <> #13);
            gotoxy(6,3);
            write(' ':30);
         end;
   until move = good;
   gotoxy(xarrw,yarrw);
   write('      ');
   makmove.imm := num1;  {set final move selected by player}
   makmove.jmm := num2;
end;

Procedure Lookahead(var value:bestmvetype;
                      iterations:shortint;
                      possmvs:posmvarrytype;
                      board2:boardarrytype;whosturn:shortint;
                      var done:boolean);

var
   pass              : boolean;
   o                 : shortint;
   ov                : bestmvetype;
   tempm             : makmovetype;
   tm                : possmvsrectype;
   opponentposibles  : posmvarrytype;
   m                 : possmvsrectype;
   k                 : integer;
   size              : integer;

begin
   findmoves(board2,-whosturn,opponentposibles);
   findbestmove(value,possmvs,board2,whosturn);
   size := 0;
   while possmvs[size+1].nflps<>0 do
      size := size + 1;
   if size <= 0 then
      pass := true
   else if (size = 1) or (iterations = 0) then
      done := true
   else
      begin
         if whosturn = 1 then
            begin
               o := -1;
               ov.val := -3500;
            end
         else
            begin
               o := 1;
               ov.val := 3500;
            end;
         tm.row := value.xcoord;
         tm.col := value.ycoord;
         tempm.imm := tm.row;
         tempm.imm := tm.col;
         k:=1;
         if not pass then
         while (possmvs[k].nflps<>0)  do begin

            unmove(board2,tempboard2,save);
            makemoves(tempm,board2,whosturn);
            Lookahead(ov,iterations-1,opponentposibles,
                      board2,-whosturn,done);
            unmove(board2,tempboard2,return);
            if (whosturn = 1) and (ov.val > value.val) then
               begin
                  value := ov;
                  m := tm;
               end
            else if (whosturn = -1) and (ov.val < value.val) then
               begin
                  value :=  ov;
                  m := tm
               end;
         k:=k+1;
         tm.row := possmvs[k].row;
         tm.col := possmvs[k].col;
         tempm.imm := tm.row;
         tempm.imm := tm.col;
         end;
      end;
end;

procedure first_move(var board:boardarrytype);
{control the players move, if none then pass}
var
   level,                       {search level}
   xarrw, yarrw,
   num1, num2   : shortint;
   possmvs      : posmvarrytype;
   value        : bestmvetype;
   makmove      : makmovetype;
begin
   findmoves(board,firstnum,possmvs);    {make sure move is possible}
   if possmvs[1].nflps = 0 then
      begin
         gotoxy(6,3);
         write('No moves, turn passed. Wait...');
         gotoxy(6,4);
         write(' ':30);
         delay(2000);
      end
   else
      begin
         unmove(board,tempboard,save);
         getcoord(firstnum,possmvs,makmove);
{************for debuggung purposes****************************}
{        findbestmove(value,possmvs,board,firstnum);
         with makmove do
            begin
               imm:=value.xcoord;
               jmm:=value.ycoord;
            end;}
{**************************************************************}
         makemoves(makmove,board,firstnum);
      end;
end;

procedure second_move_1_(var board:boardarrytype);
{control computers move if none then pass}
var
   xarrw, yarrw,
   num1, num2    : shortint;
   possmvs       : posmvarrytype;
   makmove       : makmovetype;
   value         : bestmvetype;
   done          : boolean;
begin
   findmoves(board,secondnum,possmvs);
   if possmvs[1].nflps = 0 then
      begin
         gotoxy(6,3);
         write('No moves, turn passed. Wait...');
         gotoxy(6,4);
         write(' ':30);
         delay(1500);
      end
   else
      begin
         finalcount(board,num1,num2);
         gotoxy(6,3);
         write(' ':30);
         xarrw := 42;
         yarrw := 3;
         gotoxy(xarrw,yarrw);
         write('      ');
         yarrw := 5;
         gotoxy(xarrw,yarrw);
         write('»════>');
         gotoxy(6,4);
         write('Thinking...',' ':20);
{******** For debugging purposes *******************************}
{findmoves(board,secondnum,possmvs);
findbestmove(value,possmvs,board,secondnum);
value_print(value,possmvs);}
{Andy}  {unmove(board,board2,save);
         findbestmove(value,possmvs,board2,secondnum);
         gotoxy(6,3);
         write('Andy :  ',value.xcoord,'   ',value.ycoord);}
{Erich} {gotoxy(6,4);
         write('Erich : ',makmove.imm,'   ',makmove.jmm);}
{***************************************************************}
         unmove(board,board2,save);
         lookahead(value,level,possmvs,board2,secondnum,done);
         makmove.imm := value.xcoord;
         makmove.jmm := value.ycoord;
         delay(500);
         gotoxy(6,4);
         write(' ':30);
         gotoxy(6,3);
         write(' ':30);
         gotoxy(xarrw,yarrw);
         write('      ');
         makemoves(makmove,board,secondnum);
      end;
end;

procedure second_move_2_(var board:boardarrytype);
{if computer is not playing then this controls second players move}
var
   level,
   xarrw, yarrw,
   num1, num2   : shortint;
   possmvs      : posmvarrytype;
   value        : bestmvetype;
   makmove      : makmovetype;
begin
   findmoves(board,secondnum,possmvs);
   if possmvs[1].nflps = 0 then
      begin
         gotoxy(6,3);
         write('No moves, turn passed. Wait...');
         gotoxy(6,4);
         write(' ':30);
         delay(1500);
      end
   else
      begin
         unmove(board,tempboard2,save);
         getcoord(secondnum,possmvs,makmove);
         makemoves(makmove,board,secondnum);
      end;
end;

procedure deter_winner(game:gamestatus);
{this procedure will determine a winner at the end of the game}
var
   i, j : shortint;
begin
   finalcount(board,i,j);
   gotoxy(6,3);
   write(' ':30);
   gotoxy(6,3);
   if (i+j<>64) then
      begin
         if quit = true then
            write('Game Stopped.              ')
         else
            write('No moves for either player.');
         if i>j then
            begin
               gotoxy(6,4);
               write('Player #1 Wins!!!');
            end
         else if i<j then
            begin
               gotoxy(6,4);
               write('Player #2 Wins!!!');
            end
         else
            begin
               gotoxy(6,4);
               write('Tie!!!           ')
            end
      end
   else if (i+j)=64 then
      begin
         gotoxy(6,4);
         write(' ':30);
         gotoxy(6,3);
         if game=first_win then
            write('Player #1 Wins!!!')
         else if game=second_win then
            begin
               write('Player #2 Wins!!!');
               gotoxy(6,4);
               write('HA! HA!');
            end
         else if game=tie then
            write('Tie!!!           ');
      end;
end;

procedure check_game_done(var done:boolean);
{check to see if the game is at a standstill and game is over}
var
   i, j     : shortint;
   possmvs : posmvarrytype;
begin
   findmoves(board,firstnum,possmvs);
   i := possmvs[1].nflps;
   findmoves(board,secondnum,possmvs);
   j := possmvs[1].nflps;
   if (i=0) and (j=0) then
      done := true;
   if not done then
      pass := false;
end;

procedure pick_option(play:playtype);
{pick an option during the playing of the game}
var
   i,
   d1,
   d2      : shortint;       {necessary dummy variables for locate_square}
   d3      : coordstatustype;
   d4      : boolean;
   possmvs : posmvarrytype;
   value   : bestmvetype;
begin
   if play = first then
      i := firstnum
   else
      i := secondnum;
   locate_square(d1,d2,d3,d4,board,i);
   ch := readkey;
   ch := upcase(ch);
   if ch in ['Q','P','U','S','H'] then
      begin
         case ch of
            'Q': begin
                    quit := true;
                    done := true;
                    game := tie;
                 end;
            'P': begin
                    gotoxy(6,3);
                    write('Too bad!!!');
                    unmove(board,tempboard,save);
                    pass := true;
                    delay(1500);
                 end;
            'U': begin
                    gotoxy(6,3);
                    write('You don''t think clear!!!');
                    if not play_1 then
                       begin
                          if play = first then
                             unmove(board,tempboard,return)
                          else
                             unmove(board,tempboard2,return)
                       end
                    else
                       unmove(board,tempboard,return);
                    print_board(board,game);
                    delay(1500);
                 end;
            'S': begin
                    gotoxy(6,3);
                    write('Cant handle it???');
                    reverse_board(board);
                    unmove(board,tempboard,save);
                    pass := true;
                    delay(1500);
                 end;
            'H': begin
                    gotoxy(6,3);
                    write('Hope It Helps???');
                    if play = first then
                       begin
                          findmoves(board,firstnum,possmvs);
                          findbestmove(value,possmvs,board,firstnum);
                       end
                    else
                       begin
                          findmoves(board,secondnum,possmvs);
                          findbestmove(value,possmvs,board,secondnum);
                       end;
                    d1:=42;
                    d2:=8;
                    for i:=2 to value.ycoord-1 do
                       d1:=d1+5;
                    for i:=2 to value.xcoord-1 do
                       d2:=d2+2;
                    gotoxy(d1,d2);
                    highvideo;
                    textattr := textattr+128;
                    write('═>');
                    normvideo;
                    lowvideo;
                    delay(1500);
                 end;
            end;
      end;
end;

procedure execute_first_move;
{execute first players move}
begin
   if (game = continue) and (not pass) then
      begin
         first_move(board);
         print_board(board,game);
      end;
   pass := false;
end;

procedure execute_second_move;
{execute second players move-computer or person is determined}
var
   i, j : shortint;
begin
   if not play_1 then
      begin
         play := second;
         finalcount(board,i,j);
         if i+j<>64 then
            pick_option(play)
         else
            game:=tie;
      end;
   if (game = continue) and (not pass) then
      begin
         if play_1 then
            begin
              finalcount(board,i,j);
               if i+j<>64 then
                   second_move_1_(board);
               print_board(board,game);
               pass := false;
            end
         else
            begin
               second_move_2_(board);
               print_board(board,game);
            end
      end;
end;

procedure terminate_game;
{termination procedures of game}
var
   ch : char;
begin
   ch := readkey;
   cursor('M',on);
   cursor('M',on);
end;

{ MAIN-ROUTINE }
{ Controls Initializing, Processing, and Termination }
Begin
   init_game(board);
   repeat
      pick_option(first);
      execute_first_move;
      execute_second_move;
      check_game_done(done);
   until (game <> continue) or (done);
   deter_winner(game);
   terminate_game;
End.